home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 8: LINUX Games / Linux Cubed Series 8 - LINUX Games.iso / games / x11 / rpg / crossfir.92 / crossfir / crossfire-0.92.5 / lib / adm / map_check < prev    next >
Text File  |  1996-07-24  |  8KB  |  333 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # (C) Copyright Markus Weber, 1994. All rights reserved.
  4. #     Permission is granted to use, copy, and modify for non-commercial use.
  5. #
  6.  
  7. # usage: check-consistency.pl [options]...
  8. # Options:
  9. # archdb=pathname-of-archetype-database        *** not used ***
  10. #    default    ./ARCHDB .{dir,pag}
  11. # archetypes=pathname-of-archetypes-file
  12. #    default    $cfdir/lib/archetypes
  13. # cfdir=pathname-to-crossfire-installation
  14. #    default /opt/cf0901    (hardcoded)
  15. # mapdir=pathname-of-map-directory
  16. #    default $cfdir/lib/maps
  17. # start-map=map-path-of-starting map
  18. #    default (init in archetypes)
  19.  
  20. # %% make it a command line option
  21. $debug = 1;
  22.  
  23. #
  24. #    ARGUMENT PROCESSING
  25. #
  26. # preset options
  27. $cfdir = "/home/sleipner/a/tars/crossfire/";
  28. $archdb = "./ARCHDB";
  29.  
  30. # loop thru arg vector
  31. while (@ARGV) {
  32.     $_ = @ARGV[0];
  33.     if (/^archdb=/) {
  34.         ($junk,$archdb) = split(/=/,$ARGV[0]);
  35.         shift;
  36.     }
  37.     elsif (/^archetypes=/) {
  38.         ($junk,$archetypes) = split(/=/,$ARGV[0]);
  39.         shift;
  40.     }
  41.     elsif (/^cfdir=/) {
  42.         ($junk,$cfdir) = split(/=/,$ARGV[0]);
  43.         shift;
  44.     }
  45.     elsif (/^mapdir=/) {
  46.         ($junk,$mapdir) = split(/=/,$ARGV[0]);
  47.         shift;
  48.     }
  49.     elsif (/^start-map=/) {
  50.         ($junk,$start_map) = split(/=/,$ARGV[0]);
  51.         shift;
  52.     }
  53. }
  54.  
  55. # post-process
  56. $mapdir = "$cfdir/lib/maps" unless defined($mapdir);
  57. $archetypes = "$cfdir/lib/archetypes" unless defined($archetypes);
  58. print STDERR "DBG: archetypes=$archetypes\n" if $debug > 5;
  59. print STDERR "DBG: archdb=$archdb\n" if $debug > 5;
  60. print STDERR "DBG: mapdir=$mapdir\n" if $debug > 5;
  61.  
  62. # open archetypes database
  63. print STDERR "DBG: opening archdb: $archdb\n" if $debug > 5;
  64. # %% performance booster: put assoc arrays in dbm files:
  65. #if ( -f "$archdb.pag) { $skip_db_init = 1; }
  66. #dbmopen(%ARCHDB,$archdb,0644) || die "can't dbmopen $archdb";
  67.  
  68. #
  69. #    INIT ARCHETYPES DATABASE
  70. #
  71. print STDERR "DBG: initializing archetype database...\n" if $debug;
  72. &init_archetypes_database;    # unless $skip_db_init;
  73. print STDERR "DBG: ...done\n" if $debug;
  74. defined($start_map) || die "FATAL: no starting map";
  75. # %% save start map in database
  76. #$ARCHDB{"_start_map"} = $start_map;
  77. print STDERR "DBG: start_map=$start_map\n" if $debug;
  78.  
  79. # select archetypes of special interest
  80. # %% skip iff $skip_db_init, dbmopen() the arrays instead
  81.  
  82. print STDERR "DBG: scanning for archetypes of special interest...\n" if $debug;
  83.  
  84. while ( ($arch,$type) = each(%ARCHDB) ) {
  85.  
  86.     next if !defined($type);    # skip if not special
  87.  
  88.     $_ = $type;            # see below
  89.  
  90.     if ($type == 41 || $type == 66 || $type == 94) {
  91.         # EXITS: archetypes with exits to other maps
  92.         $EXITS{$arch} = 1;
  93.     }
  94.         # Bad Programming Style Alert. Don't try this at home!
  95.     elsif (/^1[78]$/ || /^2[679]$/ || /^3[012]$/ || /^9[123]$/) {
  96.         # CONNECT: "connected" archetypes,
  97.         # e.g. buttons, handles, gates, ...
  98.         $CONNECT{$arch} = 1;
  99.     }
  100. }
  101.  
  102. print STDERR "DBG: ...done.\n" if $debug;
  103.  
  104. #
  105. #    MAIN LOOP
  106. #
  107.  
  108. # pathname of start_map is assumed to be absolute (e.g. /village/village
  109. push(@MAPS,$start_map);
  110.  
  111. while ($map = pop(@MAPS)) {
  112.  
  113. #    print STDERR "array stack size is $#MAPS\n";
  114.     next if $visited{$map};        # skip if been here before
  115.     $visited{$map} = 1;        # flag it if not
  116.  
  117. print STDERR "DBG: visiting $map\n" if $debug;
  118. #print "visiting $map\n" if $debug;
  119.  
  120.     #
  121.     # side effect: check_map pushes any (legal) exits found on stack
  122.     #
  123.     &check_map($map);
  124. }
  125.  
  126.  
  127. #dbmclose(ARCHDB);
  128.  
  129. exit;
  130.  
  131. #
  132. #    ++++++++++++++++++++ END OF MAIN ++++++++++++++++++
  133. #
  134.  
  135. #
  136. # INIT ARCHETYPES DATABASE
  137. #
  138. # store (archname,type) pairs
  139. #
  140. sub init_archetypes_database {
  141.     local($arch_lines,$arches);    # counters
  142.     local($arch,$type,$slaying);    # values
  143.     local($junk);
  144.  
  145. print STDERR "DBG: opening archetypes: $archetypes\n" if $debug > 5;
  146.     open(ARCHETYPES,$archetypes) || die "can't open $archetypes";
  147.  
  148.     $arch_lines = 0;
  149.     $arches = 0;
  150.     $type = 0;
  151.  
  152.     while ( <ARCHETYPES> ) {
  153.         $arch_lines++;
  154.         if (/^Object\s/) {
  155.             ($junk,$arch) = split;
  156.             if (!defined($arch)) {
  157.         print STDERR "$archetypes: bad Object, line $arch_lines\n";
  158.             }
  159.         }
  160.         elsif (/^type\s/) {
  161.             ($junk,$type) = split;
  162.             if (!defined($type)) {
  163.         print STDERR "$archetypes: bad type, line $arch_lines\n";
  164.             }
  165.         }
  166.         elsif (/^slaying\s/ && $arch eq "map") {
  167.             ($junk,$slaying) = split;
  168.             # don't care if defined or not (yet)
  169.         }
  170.         elsif (/^end$/) {
  171. print STDERR "DBG: entered arch=$arch, optional type=$type\n" if $debug > 10;
  172.             next if (!defined($arch));
  173.             # don't care whether $type defined or not
  174.             $ARCHDB{$arch} = $type;
  175.             $arches++;
  176.             $type = 0;
  177.         }
  178.     }
  179.  
  180.     #
  181.     # find start map
  182.     # print error message iff "map" arch not found or missing path
  183.     # assign start map (unless pre-defined on cmd line)
  184.     #
  185.     if (!defined($slaying)) {
  186.         print STDERR "***ERROR*** no map object or map path missing\n";
  187.     }
  188.     elsif (!defined($start_map)) {
  189.         $start_map = $slaying;
  190.     }
  191. #print STDERR "DBG: start_map=$start_map\n";
  192.  
  193.     close(ARCHETYPES);
  194. print STDERR "DBG: closed $archetypes, $arch_lines lines, $arches arches\n"
  195.         if $debug > 5;
  196. }
  197.  
  198. #
  199. # CHECK MAP FOR ELEMENTARY CONSISTENCY
  200. #
  201.  
  202. sub check_map {
  203.     local($map) = @_;
  204.     local($arch,$connected,$slaying,$exit,$x,$y);
  205.     local($lines,$fullmap);
  206.     local($junk);
  207.  
  208.     # build full pathname (nb: map path starts with /) and open map file
  209.     $fullmap = "$mapdir$map";
  210.     open(MAP,$fullmap) || die "can't open $fullmap";
  211. print STDERR "DBG: opened $map\n" if $debug > 5;
  212.  
  213.     $lines = 0;
  214.  
  215.     while ( <MAP> ) {
  216.         $lines++;
  217.         if (/^arch\s/) {
  218.             ($junk,$arch) = split;
  219.             undef($slaying);
  220.             undef($x);
  221.             undef($y);
  222.             undef($connected);
  223.         }
  224.         elsif (/^connected\s/) {
  225.             ($junk,$connected) = split;
  226.         }
  227.         elsif (/^slaying\s/) {
  228.             ($junk,$slaying) = split;
  229.         }
  230.         elsif (/^hp\s/) {
  231.             ($junk,$x) = split;
  232.         }
  233.         elsif (/^sp\s/) {
  234.             ($junk,$y) = split;
  235.         }
  236.  
  237.         next if !/^end$/;    # continue iff not end of arch
  238.  
  239.         #
  240.         # CHECK 1: valid archetype?
  241.         #
  242.         if (!defined($ARCHDB{$arch})) {
  243. #print STDERR "FATAL: map $map, line $lines, bad archetype: $arch\n";
  244. print "FATAL: map $map, line $lines, bad archetype: $arch\n";
  245.             next;
  246.         }
  247.  
  248.         #
  249.         # CHECK 2: connect-arch actually connected?
  250.         #    NB: if not, that's perfectly legal, but suspicious
  251.         #
  252. #        if ($CONNECT{$arch}) {
  253. #            if (!$connected) {
  254. #print STDERR "WARNING: map $map, line $lines, arch $arch, not connected\n";
  255. #print "WARNING: map $map, line $lines, arch $arch, not connected\n";
  256. #            }
  257. #            next;
  258. #        }
  259.  
  260.         next if !$EXITS{$arch};    # continue if not an exit
  261.  
  262.         #
  263.         # CHECK 3: exit-type arch, but no path given
  264.         #    Presumably the path defaults to the local map,
  265.         #    but in all probability this is an error
  266.         #
  267.         if (!defined($slaying)) {
  268.             if ($x || $y) {
  269. #print STDERR "ERROR: map $map, line $lines, arch $arch, exit defaults\n";
  270. print "ERROR: map $map, line $lines, arch $arch, exit defaults\n";
  271.             }
  272.             else {
  273. #print STDERR "INFO: map $map, line $lines, arch $arch, no exit defined\n";
  274. #print "INFO: map $map, line $lines, arch $arch, no exit defined\n";
  275.             }
  276.             next;
  277.         }
  278.  
  279.         #
  280.         # CHECK 4: verify that exit map exists
  281.         #    if not, the game (hopefully!) won't crash, but
  282.         #    chances are this _is_ an error
  283.         #
  284.  
  285.         #
  286.         # normalize exit path    (FullyQualifiedPathName :-)))
  287.         # (i.e. construct absolute pathname, rooted in CLibDir/maps)
  288.         # E.g.:
  289.         # current map: /village/somewhere
  290.         #    EXIT PATH        YIELDS
  291.         #    /village/building    /village/building    
  292.         #    townhouse        /village/townhouse
  293.         #    ../island        /island
  294.         #
  295.         $_ = "$map $slaying";    # easy matching :-)
  296.         #    /path/map exit        --> /path/map /path/exit
  297.         s@^(/.*/)([^/]*)\s([^\./].*)$@\1\2 \1\3@;
  298.         #    /path/map ../exit    --> /path/map /path/../exit
  299.         s@^(/.*/)([^/]*)\s(\.\./.*)$@\1\2 \1\3@;
  300.         #    /dir/../        --> /    (all occurances)
  301.         s@/[^/]*/\.\./@/@g;
  302.         
  303.         ($junk,$exit) = split;
  304. #print STDERR "DBG: exit $map $exit\n" if $debug > 5;
  305. #print "exit $map $exit\n";
  306.  
  307.         #
  308.         # shortcut: if the exit map was already checked, don't bother
  309.         #    stacking it again.
  310.         # %% if a map is never pushed twice in the first place,
  311.         #    the corresponding test in the main loop is probably
  312.         #    in vain.
  313.         #
  314.         next if $visited{$exit};
  315.  
  316.         #
  317.         # this is check 4, finally.
  318.         # if exit map can't be opened, complain and continue
  319.         #
  320.         if ( ! (-r "$mapdir$exit") ) {
  321. #print STDERR "ERROR: map $map, arch $arch, line $lines, no such exit $exit\n";
  322. print "ERROR: map $map, arch $arch, line $lines, no such exit $exit\n";
  323.             next;
  324.         }
  325.  
  326.         #
  327.         # the exit map looks good; push it and continue
  328.         push(@MAPS,$exit);
  329.     }
  330.  
  331.     close(MAP);
  332. }
  333.